(** This module provides a representation of a jvm class file in ocaml.

 It is very closely modeled after the Class File Format Specification, thus probably not the most beautiful
 ocaml module you have ever seen. But this way it is easierer to maintain and understand the file format and
 hopefully all of the ideosyncracies of the format are abstracted away, so if you use this module, you should
 only ever come in contact with its functions, and seldom directly create its types yourself.
 
 @see <http://java.sun.com/docs/books/jvms/second_edition/html/ClassFile.doc.html> JVM Spec
 @author Oliver Jan Krylow 2010 *)

open Jvm_type

(** jvm class file format is identifaiable through magic number 0xCAFEBABE *)
type t = {
	version: jvm_version ; (** major versions for each java platform 1.1 - 1.7 . Our compiler targets 1.6 -> major_version = 50. But we leave this value variable 
	 here, in case we decide to implement backwards compatibility or when 1.7 is released ... Note: minor versions are mostly 0. *)
	
	constant_pool: cp_info DynArray.t ; (** The constant pool in a class file is an indexed array of data. Constant data, like primitives and strings or symbolic data like 
	class, field, method names etc. 
	In order to avoid redundancy, thus keep the file size small, everywhere in a classfile one can refer into the constant pool, even from within the constant pool itself. *)
	
	access_flags: access_flag list ; (** Defines scoping in package ( private, public ) and / or accessebility rules ( abstract ) *)
	
	this: int; (** Index into constant pool to fully qualified name of the class.  *)
	
	mutable super: int; (** Index into constant pool to fully qualified name of the super class.*)
	
	mutable interfaces: int list; (** indecies of interface signatures in cp *)
	
	mutable fields: field_info list; (** A sequence of datastructures, that hold information about this classes fields. *)
	
	mutable methods: method_info list; (** A sequence of datastructures, that hold information about this classes methods. *)
	
	mutable attributes: attribute_info list (** A sequence of datastructures, that hold information about this classes attributes. *)
}

(** Although, in theory, compiling against lower versions should always result in bytecode executable by the newest JVMs, for 
 performance, and feature reasons, we want to be very aware of our target version.
 Because a JVM is obliged to silently ignore in some cases data structures it does not recognize ( see jvm_annotation ),
 we have to be careful in order to not introduce unnecessary overhead. *)
and jvm_version =
	| JDK_1_1 (* 0x002D *)
	| JDK_1_2 (* 0x002E *)
	| JDK_1_3 (* 0x002F *)
	| JDK_1_4 (* 0x0030 *)
	| JDK_1_5 (* 0x0031 *)
	| JDK_1_6 (* 0x0032 *)
	| JDK_1_7 (* 0x0033 *)

(** This is a structered representation of data storable in the constant pool. *)
and cp_info =
	| Utf8Const of string (*0x1*)
	| IntegerConst of int32 (*0x3*)
	| FloatConst of float (*0x4*)
	| LongConst of int64 (*0x5*)
	| DoubleConst of float (*0x6*)
	| StringConst of int (*0x8*)
	| Class of int (*0x7*)
	| FieldRef of int * int (*0x9*)
	| MethodRef of int * int (*0x10*)
	| InterfaceMethodRef of int * int (*0x11*)
	| NameAndType of int * int (*0x12*)

(** Attributes are a flexible datastructure and provide means to annotate classes, methods, fields and even attributes themselves
 with metadata. In the case of methods and fields this can mean implementation logic ( code_attr_info ) or constant data ( ConstantValue )
 or debugging information or additional type information ... 
 One could even invent arbitrary attributes for specific contexts ( like HaXe compilation ^^ ), because JVMs are to ignore unknown
 attributes.
 TODO:change Attribute values currently map to (arbitrary) constant cp 
 index values Also Warning! Although all attributes are collected as     
 attribute_info type, not every attribute makes sense in every attribute 
 slot (like global attributes in t or local ones in Code). Jvms will     
 silently ignore attributes in wrong places, and attributes it does not  
 recognize, so we have to be sure to do the right thing.                 *)
and attribute_info =
	| ConstantValue of int (** for static field_info *)(* may change 0x0011 -> "ConstantValue" in cp , 0x00000002 *) 
	| Code of code_attr_info (* '' 0x0012 -> "Code" in cp *)
	| StackMap of stackmap_frame list (** the stackmap gives type information on opcodes the jvm bytecode 
	verifier otherwise would have to infer. By baking the type state into the class file, the startuptime of your jvm program should be faster ... TODO:proof *)(* '' 0x0013 -> "StackMapTable" in cp *)
	| Exceptions of int list (* '' 0x0014 -> "Exceptions" in cp *)(** the exceptions attribute describes checked exceptions a method can throw. 
	TODO:think how does this apply to haxe ? *)
	| InnerClasses of inner_class list (** the innerClasses attribute lists nested classes and interfaces they 
	 can't belong to a package and the jvm does not check the existence of a corresponding class file when it parses this attribute , so we have to do it ourselves *)(* '' 0x0015 -> "InnerClasses" in cp *)
	| EnclosingMethod of int * int (** the enclosingMethod attribute is required for nested (anonymous) classes *)(* '' 0x0016 -> "EnclosingMethod" in cp , 0x00000004*)
	| SyntheticAttr (* '' 0x0017 -> "Synthetic" in cp , 0x0 . Note: same as synthetic flag. redundancy never hurts ^^ *)
	| SignatureAttr of int (** index of signature in cp *)(* '' 0x0018 -> "Signature", 0x00000002 *)
	| SourceFile of int (** index of source file name in cp *)(* '' 0x0019 -> "SourceFile", 0x00000002 *)
	| SourceDebug of string (** this attribute holds arbitrary information in form of utf8 string (sans terminating \0) *)(* '' 0x001A -> "SourceDebugExtension" *)(* TODO:think how is this useful? *)
	| LineNumbers of (int * int) list (** essentially a map of opcodes to source file line numbers *)(* '' 0x001B -> "LineNumberTable" *)
	| LocalVariables of local_var list (** gives information for debuggers about local variables values *)(* '' 0x001C -> "LocalVariableTable" *)
	| LocalVariablesType of local_var list (** this gives extra info for vars used as generic reference *)(* '' 0x001D -> "LocalVariableTypeTable" *)
	| Deprecated (* '' 0x001E -> "Deprecated", 0x00000000 *)
	| RuntimeVisibleAnnotations (* TODO:explore do annotations in haxe have meaning ? *)
	| RuntimeInvisibleAnnotations
	| RuntimeVisibleParameterAnnotations
	| RuntimeInvisibleParameterAnnotations
	| AnnotationDefault
(* TODO:explore is having a haxe attribute to maybe store information lost *)
(* in compilation useful ?                                                 *)

(** this attribute holds the meat of a method, its buisness logic in form of a sequence of opcodes. *)
and code_attr_info = {
	
	co_max_stack : int ;
	co_max_locals : int;
	
	co_code : opcode list ;
	
	co_exceptions : exception_table list;
	
	co_attributes : attribute_info list(*TODO:implement check for valid attributes here*)
}
and exception_table = {
	ex_start_pc : int;
	ex_end_pc : int ;
	ex_handler_pc : int;
	ex_catch_type : int
}

(** JVM instruction set. 
 These instructions describe all commands expressable on a JVM. 
 A JVM is a stack-based machine, meaning its opcodes potentially have access to data other than
 their given arguments. This data is "loaded" and "pushed" from a stack, which is characterized by its FIFO ( first in first out ) behavior.
 It is also worth noting, that data in a sequence of opcodes is typed implicitly. You may have noticed, that almost every opcode
 has multiple versions, one for every data type known to a JVM ( see t ). This means if you pass an addressReference to an opcode
 that expects an int, you might get unexpected results.
  *)
and opcode =
	| AaLoad (** pushes a reference from array onto operand stack*) (*0x32*)
	| BaLoad (** pushes a byte or boolean from array onto operand stack *)(*0x33*)
	| CaLoad (** pushes a char from array onto operand stack *)(*0x34*)
	| DaLoad (** pushes a double from array onto operand stack *)(*0x31*)
	| FaLoad (** pushes a float from array onto op stack *)(*0x30*)
	| IaLoad (** pushes an int from array onto op stack *)(*0x2E*)
	| LaLoad (** pushes a long from array onto opstack *)(*0x2F*)
	| SaLoad (** pushes a short from array onto opstack *)(*0x35*)
	| Aload of int (** loads reference from local variable array at index *) (*0x19*)
	| Aload_0 (*0x2A*)
	| Aload_1 (*0x2B*)
	| Aload_2 (*0x2C*)
	| Aload_3 (*0x2D*)
	| Dload of int (** push double from local variable array onto op stack *)(*0x18*)
	| Dload_0 (*0x26*)
	| Dload_1 (*0x27*)
	| Dload_2 (*0x28*)
	| Dload_3 (*0x29*)
	| Fload of int (** push float from local var array onto op stack *)(*0x17*)
	| Fload_0 (*0x22*)
	| Fload_1 (*0x23*)
	| Fload_2 (*0x24*)
	| Fload_3 (*0x24*)
	| Iload of int (** push int from local var array onto opstack *)(*0x15*)
	| Iload_0 (*0x1A*)
	| Iload_1 (*0x1B*)
	| Iload_2 (*0x1C*)
	| Iload_3 (*0x1D*)
	| Lload of int (** push long from lva onto opstack *)(*0x16*)
	| Lload_0 (*0x1E*)
	| Lload_1 (*0x1F*)
	| Lload_2 (*0x20*)
	| Lload_3 (*0x21*)
	| AaStore (** store into array<reference> *) (*0x53*)
	| BaStore (** store into array<byte | boolean> *)(*0x54*)
	| CaStore (** store into array<char> *)(*0x55*)
	| DaStore (** store into array<double> *)(*0x52*)
	| FaStore (** store into array<float> *)(*0x51*)
	| IaStore (** store into array<int> *)(*0x4F*)
	| LaStore (** store into array<long> *)(*0x50*)
	| SaStore (** store into array<short> *)(*0x56*)
	| Astore of int (** stores reference into local variable at index *)(*0x3A*)
	| Astore_0 (*0x4B*)
	| Astore_1 (*0x4C*)
	| Astore_2 (*0x4D*)
	| Astore_3 (*0x4E*)
	| Dstore of int (** stores double into local variable array *)(*0x39*)
	| Dstore_0 (*0x47*)
	| Dstore_1 (*0x48*)
	| Dstore_2 (*0x49*)
	| Dstore_3 (*0x4A*)
	| Fstore of int (** stores float into local var array *)(*0x38*)
	| Fstore_0 (*0x43*)
	| Fstore_1 (*0x44*)
	| Fstore_2 (*0x45*)
	| Fstore_3 (*0x46*)
	| Istore of int (** stores int into local variable array *)(*0x36*)
	| Istore_0 (*0x3B*)
	| Istore_1 (*0x3C*)
	| Istore_2 (*0x3D*)
	| Istore_3 (*0x3E*)
	| Lstore of int (** stores long into local var array *)(*0x37*)
	| Lstore_0 (*0x3F*)
	| Lstore_1 (*0x40*)
	| Lstore_2 (*0x41*)
	| Lstore_3 (*0x42*)
	| AconstNull (** push null onto operand stack *) (*0x1*)
	| AnewArray of int (** creates new array<reference> of item in constant pool *) (*0xBD*)
	| Areturn (** returns reference from method *)(*0xB0*)
	| Dreturn (** returns double from method *)(*0xAF*)
	| Freturn (** returns float *)(*0xAE*)
	| Ireturn (** returns int *)(*0xAC*)
	| Lreturn (** returns long *)(*0xAD*)
	| Return (** returns void *)(*0xB1*)
	| ArrayLength (** push length of referenced array onto operand stack *)(*0xBE*)
	| Athrow (** throws referenced exception or error *) (*0xBF*)
	| BiPush of int (** push byte as int onto operand stack *)(*0x10*)
	| SiPush of int (** push short as int onto opstack *)(*0x11*)
	| Swap (** swap two top opstack values if not double or long *)(*0x5F*)
	| CheckCast of int (** checks if referenced object is of same type as object in constant pool at index *)(*0xC0*)
	| D2f (** convert double on operand stack to float *)(*0x90*)
	| D2i (** convert double to int *)(*0x8E*)
	| D2l (** convert double to long *)(*0x8F*)
	| F2d (** convert float to double *)(*0x8D*)
	| F2i (** convert float to int *)(*0x8B*)
	| F2l (** convert float to long *)(*0x8C*)
	| I2b (** int to byte *)(*0x91*)
	| I2c (** int to char *)(*0x92*)
	| I2d (** int to double *)(*0x87*)
	| I2f (** int to float *)(*0x86*)
	| I2l (** int to long *)(*0x85*)
	| I2s (** int to short *)(*0x93*)
	| L2d (** long to double *)(*0x8A*)
	| L2f (** long to float *)(*0x89*)
	| L2i (** long to int *)(*0x88*)
	| Dadd (** adds two doubles on operand stack *)(*0x63*)
	| Fadd (** adds two floats on op stack *)(*0x62*)
	| Iadd (** adds ints *)(*0x60*)
	| Ladd (** adds longs *)(*0x61*)
	| Dcmpg (** compares two doubles on op stack . if NaN, 1 *)(*0x98*)
	| Dcmpl (** compares two doubles on op stack . if NaN , -1 *)(*0x97*)
	| Fcmpg (** compares two floats on op stack . if NaN , 1 *)(*0x96*)
	| Fcmpl (** compares two floats . if NaN , -1 *)(*0x95*)
	| Lcmp (** compares longs *)(*0x94*)
	| IfAcompeq of int (** compare two referenced object on opstack and jump to offset if equal *)(*0xA5*)
	| IfAcompne of int (** '' if not equal *)(*0xA6*)
	| IfIcompeq of int (** compare two ints on opstack and jump to offset if equal *)(*0x9F*)
	| IfIcompne of int (** '' if not equal *)(*0xA0*)
	| IfIcomplt of int (** '' if less than *)(*0xA1*)
	| IfIcomple of int (** '' if less than or equal *)(*0xA4*)
	| IfIcompgt of int (** '' if greater than *)(*0xA2*)
	| IfIcompge of int (** '' if greater than or equal *)(*0xA3*)
	| Ifeq of int (** if int on opstack is 0 ,jump to offset *)(*0x99*)
	| Ifne of int (** '' is not 0 '' *)(*0x9A*)
	| Iflt of int (** '' is less than 0 '' *)(*0x9B*)
	| Ifle of int (** '' is less than or equal '' *)(*0x9E*)
	| Ifgt of int (** '' is greater than '' *)(*0x9D*)
	| Ifge of int (** '' is greater than or equal '' *)(*0x9C*)
	| IfNonNull of int (** if reference is not null ,jump to offset *)(*0xC7*)
	| IfNull of int (** '' is null '' *)(*0xC6*)
	| Dconst_0 (** push 0.0 onto op stack *)(*0xE*)
	| Dconst_1 (** push 1.0 onto op stack *)(*0xF*)
	| Fconst_0 (** push 0.0 onto op stack *)(*0xB*)
	| Fconst_1 (** push 1.0 onto op stack *)(*0xC*)
	| Fconst_2 (** push 2.0 onto op stack *)(*0xD*)
	| Iconst_m1 (** push -1 *)(*0x2*)
	| Iconst_0 (** push 0 *)(*0x3*)
	| Iconst_1 (** push 1 *)(*0x4*)
	| Iconst_2 (** push 2 *)(*0x5*)
	| Iconst_3 (** push 3 *)(*0x6*)
	| Iconst_4 (** push 4 *)(*0x7*)
	| Iconst_5 (** push 5 *)(*0x8*)
	| Lconst_0 (** push 0 *)(*0x9*)
	| Lconst_1 (** push 1 *)(*0xA*)
	| Ddiv (** divide two doubles on op stack *)(*0x6F*)
	| Fdiv (** divide two floats *)(*0x6E*)
	| Idiv (** divide ints *)(*0x6C*)
	| Ldiv (** divide longs *)(*0x6D*)
	| Dmul (** multiply two doubles on op stack *)(*0x6B*)
	| Fmul (** multiply floats *)(*0x6A*)
	| Imul (** multiply ints *)(*0x68*)
	| Lmul (** multiply longs *)(*0x69*)
	| Dneg (** negate double on op stack *)(*0x77*)
	| Fneg (** negate float *)(*0x76*)
	| Ineg (** negate int *)(*0x74*)
	| Lneg (** negate long *)(*0x75*)
	| Drem (** modulo of two doubles on op stack *)(*0x73*)
	| Frem (** modulo floats *)(*0x72*)
	| Irem (** modulo ints *)(*0x70*)
	| Lrem (** modulo longs *)(*0x71*)
	| Dsub (** subtraction or two doubles on op stack *)(*0x67*)
	| Fsub (** sub floats *)(*0x66*)
	| Isub (** sub ints *)(*0x64*)
	| Lsub (** sub longs *)(*0x65*)
	| Dup (** duplicate top op stack value if not double or long and push onto op stack*)(*0x59*)
	| Dup_x1 (** '' at index -2 relative to value *)(*0x5A*)
	| Dup_x2 (** '' at index -3 '' *)(*0x5B*)
	| Dup2 (** '' if double or long and push onto op stack *)(*0c5C*)
	| Dup2_x1 (** '' at index -2 relative to value *)(*0x5D*)
	| Dup2_x2 (** '' at index -3 '' *)(*0x5E*)
	| GetField of int (** get field of referenced object at index in cp *)(*0xB4*)
	| GetStatic of int (** get static field *)(*0xB2*)
	| Goto of int (** jump to offset in current frame *)(*0xA7*)
	| Goto_w of int (** '' . Note: currently methods can have max 2^16 -1 instructions (opcodes), so this opcode is useless *)(*0xC8*)
	| Iand (** conjunction of two ints on op stack *)(*0x7E*)
	| Land (** boolean and of two longs on opstack *)(*7F*)
	| Ior (** inclusive or of two ints on opstack *)(*0x80*)
	| Ixor (** boolean xor ints *)(*0x82*)
	| Lor (** boolean or longs *)(*0x81*)
	| Lxor (** boolean xor longs *)(*0x83*)
	| Iinc of int * int (** increment int in local var array with constant *)(*0x84*)
	| InstanceOf of int (** if referenced object on opstack is instance of class, array or interface in cp push 1, else push 0 *)(*0xC1*)
	| InvokeInterface of int * int (** invokes interfaced method of referenced object on opstack with n argument on opstack .Note: for backward compatability the number of args must explicitly be set and terminate with a 0 byte *)(*0xB9*)
	| InvokeSpecial of int (** invokes super ,private and constructor method of referenced object on opstack with n args on opstack *)(*0xB7*)
	| InvokeStatic of int (** invokes static method with n args on opstack *)(*0xb8*)
	| InvokeVirtual of int (** invokes public method of referenced object on opstack wit n args on opstack *)(*0xB6*)
	| InvokeDynamic (**jvm 1.7 feature*)
	| Ishl (** arithmetic shift left ints *)(*0x78*)
	| Ishr (** '' rigth ints *)(*0x7A*)
	| Iushr (** logical shift rigth ints *)(*0x7C*)
	| Lshl (** shift left longs *)(*0x79*)
	| Lshr (** shift right longs *)(*0x7B*)
	| Lushr (** logical shift rigth longs *)(*0x7D*)
	| Jsr of int (** jump to offset and push next opcode as returnAdress to opstack *)(*0xA8*)(*DEPRACATED*)
	| Jsr_w of int (** '' Note: see Goto_w *)(*0xC9*)(*DEPRACATED*)
	| Ldc of int (** push from cp at index onto opstack if not long or double*)(*0x12*)
	| Ldc_w of int (** '' Note: index is wide *)(*0x13*)
	| Ldc2_w of int (** '' if long or double *)(*0x14*)
	| LookupSwitch of int32 * (int32 * int32) list (** compare key on opstack to matching pairs, and jump to offset if equal, else jump to default offset *)(*0xAB*)
	| TableSwitch of int32 * int32 * int32 * int32 list (** compare value on opstack to range, if in range jump to offset defined in table entry val - low, else jump to default *)(*0xAA*)
	| MonitorEnter (** wait until its free and locks reference on opstack for threadsafe use *)(*0xC2*)
	| MonitorExit (** frees previously locked reference on opstack *)(*0xC3*)
	| MultiNewArray of int * int (** create multidim array of type indexed in cp with n dimensions and n sizes on opstack *)(*0xC5*)
	| NewArray of atype (** push array of given type and size on opstack. type is specified by number between 4 and 11 in this context *)(*0xBC*)
	| New of int (** create new object of type indexed in cp and push on opstack *)(*0xBB*)
	| NoOp (** do nuttin' *)(*0x0*)
	| Pop (** pop top opstack value if not double or long *)(*0x57*)
	| Pop2 (** '' if double or long *)(*0x58*)
	| PutField of int (** put given value into field indexed in cp of this or subclass *)(*0xB5*)
	| PutStatic of int (** put given value into static field indexed in cp *)(*0xB3*)
	| Ret of int (** jump to returnAdress indexed in local var array *)(*0xA9*)
	| Wide of opcode (** widenes the index given to opcode . Note: mostly useful to widen the increment range of Iinc *)(*0xC4*)

and atype =
	| TBoolean (*0x4*)
	| TChar (*0x5*)
	| TFloat (*0x6*)
	| TDouble (*0x7*)
	| TByte (*0x8*)
	| TShort (*0x9*)
	| TInt (*0x10*)
	| TLong (*0x11*)

(** a stackmap frame represents the type state of local variables and     
 opstack for any given opcode. each stackmap frame a implicitly refers   
 to the stackmap frame b preceding it by specifing a delta_offset ,      
 which, when added to the offset b refered to, defines the offset in the 
 code array that a is supposed to complement the way the delta_offset    
 itself is specified in a class file is quite intelligent. for each type 
 of stackmap type given below, there is a range of corresponding         
 constants a stackmap fram could be represented with. the actual value   
 inside that range is used then to calculate the actual delta_offset (by 
 subtracting some constant) BRILLIANT! you specify type and value with   
 one variable ! we will treat the stackmap frame is if it specified the  
 offset at which it applies explicity, though and calculate the actual   
 value later (since mostly constant values are involved in those calcs)  *)
and stackmap_frame =
	| Same of int
	(** the type state is the same as in the previous stackmap frame *)(* [0x00; 0x3F] , 0x00
	Note: this stackmap frame type comes also in an extended version *)
	| SameLocals1 of int * verification_type_info
	(** the type state has the same local vars as previous and 1 opstack type *)(* [0x40; 0x7F] , 0x40
	Note: if offset_delta is not expressable due to the short range there is an extended version of this stackmap frame type
	which takes an explicit offset_delta value. But since we implement the actual byte writing later, we can take care of it then *)
	| Chop of int * int (** type state has no opstack types and same local variable types as prev except last ch_num variables  *)(* [0xF8;0xFA] , 0xFB *)
	| Append of int * int * verification_type_info list (** opstack empty, locals are the same as prev plus ap_num types *)(* [0xFC;0xFE] , 0xFB *)
	| Full of int * verification_type_info list * verification_type_info list (** full type state *)(* 0xFF *)

and verification_type_info =
	| Top_var (* 0x00 *)
	| Integer_var (* 0x01 *)
	| Float_var (* 0x02 *)
	| Long_var (* 0x03 *)
	| Double_var (* 0x04 *)
	| Null_var (* 0x05 *)
	| UninitializedThis_var (* 0x06 *)
	| Object_var of int (* 0x07 *)(** index into cp *)
	| Uninitialized_var of int (* 0x08 *)(** offset in code array of new opcode initializing this variable *)

and inner_class = {
	inner_class_index : int;
	outer_class_index : int;
	
	inner_name_index : int;
	inner_access_flags : access_flag list
}

and local_var = {
	start_pc : int;
	length: int;
	name_index : int;
	des_sig_index: int; (** index of descriptor or signature in cp *)
	index : int (** index of the local var in current frame . TODO:explore how is this useful ? *)
}

(* TODO:sanitycheck merging of access flags. what if Public, Private and 
 Protected are in list? Or: implement access_flag type in such a way     
 that only one of those can be set at a time ... a more treelike         
 structure                                                               *)
and access_flag =
	| Public (* 0x0001 *)
	| Private (*0x0002*)
	| Protected (*0x0004*)
	| Static (*0x0008*)
	| Final (*0x0010*)
	| Super (* 0x0020 *)
	| Synchronized (* 0x0020 *)
	| Volatile | Bridge (*0x0040*)
	| Transient | Varargs (*0x0080*)
	| Native (* 0x0100 *)
	| Interface (* 0x0200 *)
	| Abstract (* 0x0400 *)
	| Strict (* 0x0800 *)
	| Synthetic (* 0x1000 *)
	| Annotation (* 0x2000 *)
	| Enum (* 0x4000 *)

and field_info = {
	f_access_flags : access_flag list ;
	f_name_index: int;
	f_descriptor_index: int;
	
	f_attributes: attribute_info list
}

and method_info = {
	m_access_flags : access_flag list;
	m_name_index: int;
	m_descriptor_index: int;
	
	m_attributes: attribute_info list
}

(* The following methods provide an abstraction layer for above defined    *)
(* types. It is recommended, but not absolutely necessary, to use them,    *)
(* since the above types are very closely modeled after the Class File     *)
(* Format Specification, meaning , they are not very ocaml friendly ^^     *)

exception NotYetImplemented

exception MalformedName of string

(** check if string conforms to jvm restrictions ... redundant! *)
let as_legal_name str =
	UTF8.validate str;
	str

let as_legal_field_name str =
	let name = (as_legal_name str) in
	if String.contains name '.'
	or String.contains name ','
	or String.contains name ';'
	or String.contains name '['
	or String.contains name '/'
	then (raise (MalformedName name)) (* TODO:think raise error or automatically transform to valid name using encoding scheme proposed by john rose ? *)
	else name

let as_legal_method_name str =
	let name = as_legal_field_name str in
	if String.contains name '<'
	or String.contains name '>'
	then (raise (MalformedName name)) (* TODO:think raise error or automatically transform to valid name ? *)
	else name

(** convert path to fully qualified name compatible with jvm *)
let as_fq_name (packs, name) =
	(List.fold_left ( fun pack p -> p ^ (if p = "" then "" else "/") ^ pack ) "" (List.rev packs)) ^ name

let as_signature t = ""

exception YouShouldn'tBeAskingForDescriptorOfThisJVMType
exception MultiDimensionalOverflow of string
exception TooManyParameters of Jvm_type.t list

(** Jvm_type.t -> jvm field descriptor in string form *)
let rec as_field_descriptor = function
	| Jvm_boolean _ -> "Z"
	| Jvm_byte _ -> "B"
	| Jvm_short _ -> "S"
	| Jvm_char _ -> "C"
	| Jvm_int _ -> "I"
	| Jvm_float _ -> "F"
	| Jvm_long _ -> "J"
	| Jvm_double _ -> "D"
	| Jvm_string _ -> "Ljava/lang/String;"
	| Jvm_reference ref ->
		(match ref with
				| ClassRef path
				| InterfaceRef path -> "L" ^ (as_fq_name path) ^ ";"
				| ArrayRef t ->
					let array = "[" ^ (as_field_descriptor t) in
					if (String.length array ) > 255 then (raise (MultiDimensionalOverflow array)) else array
				| Jvm_null -> "V" )
	| Jvm_addressRef _ -> (raise YouShouldn'tBeAskingForDescriptorOfThisJVMType)

(** Jvm_type.t list -> Jvm_type.t -> jvm method descriptor *)
let as_method_descriptor ?params return_type =
	"("
	^ ( match params with None -> ""
			| Some p_lst ->
				if (List.length p_lst) > 254
				then raise (TooManyParameters p_lst)
				else String.concat "" ( List.map as_field_descriptor p_lst ) )
	^ ")"
	^ (as_field_descriptor return_type)

exception Not_Found

(** put cp_info structure into constant pool and return index. if structure 
 already exists in cp , just return index.                               *)
let push cp info =
	try
		(DynArray.index_of
				(fun elem -> if elem = info then true else raise Not_Found)
				cp) + 1
	with
		| Not_Found ->
			DynArray.add cp info;
			DynArray.length cp

(** Retrieve info structure from constant pool.
 @param cp The Constant Pool to look in.
 @param index The position of the element in the Constant Pool.
 @return A 'cp_info' structure with appropiate data. *)
let get cp index = DynArray.get cp index

let add_utf8 cp str =
	push cp ( Utf8Const str )

(** take constant_pool and jvm_class and add cp_info entry of class in cp . *)
let add_class cp path =
	let name = as_fq_name path in
	push cp ( Class ( add_utf8 cp (as_legal_name name) ) )

(** cp -> jvm_construct -> add info to cp and return index list *)
let add_construct cp cons =
	List.map
		( fun tt -> let name = as_fq_name (Jvm_type.get_path tt) in
				push cp (Class ( add_utf8 cp (as_legal_name name) )))
		cons

let add_name_and_type cp name des =
	push cp ( NameAndType ( add_utf8 cp (as_legal_name name) , add_utf8 cp des ) )

let add_fieldref cp outer fld =
	let name = fld.jvm_f_name in
	let descriptor = as_field_descriptor fld.jvm_f_type in
	push cp ( FieldRef (add_class cp outer , add_name_and_type cp name descriptor) )

let add_int32 cp i =
	push cp ( IntegerConst i )

let add_float cp fl =
	push cp ( FloatConst fl )

let add_double cp l =
	push cp ( DoubleConst l )

let add_long cp l =
	push cp ( LongConst l )

let add_string cp str =
	push cp ( StringConst ( add_utf8 cp str ) )

exception UnsupportedJDKVersion

let simple_classfile name vers =
	{
		version = vers;
		constant_pool = DynArray.of_list [ Class 2 ; Utf8Const name ] ;
		access_flags = [];
		this = 1;
		super = 0;
		interfaces = [];
		fields = [];
		methods = [];
		attributes = []
	}

exception InvalidConstant

let make_constant_value cp =
	function
	| Jvm_boolean i
	| Jvm_byte i
	| Jvm_short i
	| Jvm_char i -> ConstantValue ( add_int32 cp (Int32.of_int i) )
	| Jvm_int i -> ConstantValue ( add_int32 cp i )
	| Jvm_float fl -> ConstantValue ( add_float cp fl )
	| Jvm_double l -> ConstantValue ( add_double cp l )
	| Jvm_long l -> ConstantValue ( add_long cp l )
	| Jvm_string str -> ConstantValue ( add_string cp str )
	| Jvm_reference _
	| Jvm_addressRef _ -> raise InvalidConstant

(** take in cp and list of sbstract opcodes and return code_info structure  
 wrapped in atrribute_info here actual code logic gets transformed !     *)
let make_code cp intercode =
	let c_i = {
		co_max_stack = 0;
		co_max_locals = 0;
		
		co_code = [] ;
		
		co_exceptions = [] ;
		
		co_attributes = []
	} in
	
	Code c_i

let make_field cp jfield =
	{
		f_access_flags =
			( if jfield.jvm_f_static then [ Static ] else [] )
			@ ( if jfield.jvm_f_volatile then [ Volatile ] else [] )
			@ ( if jfield.jvm_f_synthetic then [ Synthetic ] else [] )
			@ ( if jfield.jvm_f_transient then [ Transient ] else [] )
			@ ( if jfield.jvm_f_final then [ Final ] else [] )
			@ ( if jfield.jvm_f_enum then [ Enum ] else [] )
			@ [ match jfield.jvm_f_scope with
				| Jvm_public -> Public
				| Jvm_private -> Private
				| Jvm_protected -> Protected ];
		
		f_name_index = add_utf8 cp (as_legal_field_name jfield.jvm_f_name);
		
		f_descriptor_index = add_utf8 cp (as_field_descriptor jfield.jvm_f_type);
		
		(* attributes hold initial values for static fields and also meta  *)
		(* information like annotations, we have some freedom here to add  *)
		(* useful information, because a jvm is required to ignore unknown *)
		(* attributes...                                                   *)
		f_attributes =
			(List.map
					( fun ann -> (raise NotYetImplemented (* process jvm_annotations... *)) )
					jfield.jvm_f_annotations)
			@ ( if jfield.jvm_f_static then [make_constant_value cp jfield.jvm_f_type ] else [] )
	}

let make_method cp jmeth =
	{
		m_access_flags =
			( if jmeth.jvm_m_static then [ Static ] else [] )
			@ ( if jmeth.jvm_m_native then [ Native ] else [] )
			@ ( if jmeth.jvm_m_synthetic then [ Synthetic ] else [] )
			@ ( if jmeth.jvm_m_strict then [ Strict ] else [] )
			@ [ match jmeth.jvm_m_scope with
				| Jvm_public -> Public
				| Jvm_private -> Private
				| Jvm_protected -> Protected ];
		
		m_name_index = add_utf8 cp (as_legal_method_name jmeth.jvm_m_name);
		
		m_descriptor_index = add_utf8 cp (as_method_descriptor jmeth.jvm_m_type);
		
		m_attributes =
			(List.map
					( fun ann -> (raise NotYetImplemented (* process jvm_annotations... *)) )
					jmeth.jvm_m_annotations)
			@ []
	}

let as_jvm_version = function
	| 1.6 -> JDK_1_6
	| 1.1
	| 1.2
	| 1.3
	| 1.4
	| 1.5
	| 1.7
	| _ -> raise (UnsupportedJDKVersion)

(** jvm_type_type -> access_flag list *)
let as_access_flags jtt =
	match jtt with
		| Jvm_class clazz ->
			[(if clazz.jvm_c_public then Public else Private)]
			@ (if clazz.jvm_c_synthetic then [Synthetic] else [])
		
		| Jvm_interface interface ->
			[(if interface.jvm_i_public then Public else Private)]
			@ (if interface.jvm_i_synthetic then [Synthetic] else [])
		
		| Jvm_enum enum -> raise NotYetImplemented

let as_super cp jtt =
	match jtt with
		| Jvm_class clazz ->
			(match clazz.jvm_c_super with None -> 0
					| Some sup -> add_class cp sup.jvm_c_path)
		
		| Jvm_interface interface -> 0
		
		| Jvm_enum enum -> raise NotYetImplemented

let as_interfaces cp jtt =
	match jtt with
		| Jvm_class clazz ->
			List.map ( fun interface -> add_class cp interface.jvm_i_path ) clazz.jvm_c_implemented
		
		| Jvm_interface interface ->
			List.map ( fun superface -> add_class cp superface.jvm_i_path ) interface.jvm_i_implemented
		
		| Jvm_enum enum ->
			raise NotYetImplemented 

let as_fields cp jtt =
	match jtt with
		| Jvm_class clazz ->
			List.flatten (* TODO:explore is there a more elegant way to reduce a list of options into a list of values? *)
				(List.map
						( fun prop ->
								(match (Jvm_type.extract_field prop) with
										| None -> []
										| Some jfield ->
											[ make_field cp jfield ]))
						clazz.jvm_c_properties)
		
		| Jvm_interface interface ->
			List.flatten (* TODO:explore is there a more elegant way to reduce a list of options into a list of values? *)
				(List.map
						( fun prop ->
								(match (Jvm_type.extract_field prop) with
										| None -> []
										| Some jfield ->
											[ make_field cp jfield ]))
						interface.jvm_i_properties)
		
		| Jvm_enum enum -> raise NotYetImplemented

let as_methods cp jtt =
	match jtt with
		| Jvm_class clazz ->
			List.flatten (* TODO:explore is there a more elegant way to reduce a list of options into a list of values? *)
				(List.map
						( fun prop ->
								(match (Jvm_type.extract_methods prop) with
										| None , None -> []
										| Some meth , None -> [make_method cp meth]
										| Some getter , Some setter ->
											[make_method cp getter; make_method cp setter]
										| None , Some setter -> [make_method cp setter] ))
						clazz.jvm_c_properties)
		
		| Jvm_interface interface ->
			let abstract meth = 
				{ meth with
				m_access_flags = meth.m_access_flags @ [ Abstract ];
				m_attributes = 
					List.filter 
						(fun attr -> ( match attr with Code _ -> false
														| _ -> true ) ) 
						meth.m_attributes
				}
			in
			List.flatten (* TODO:explore is there a more elegant way to reduce a list of options into a list of values? *)
				(List.map
						( fun prop ->
							 (match (Jvm_type.extract_methods prop) with
										| None , None -> []
										
										| Some meth , None -> 
											[abstract (make_method cp meth)]
										
										| Some getter , Some setter ->
											[abstract (make_method cp getter); abstract (make_method cp setter)]
										
										| None , Some setter -> [abstract (make_method cp setter)] ))
						interface.jvm_i_properties)
		
		| Jvm_enum enum -> raise NotYetImplemented

let as_attributes cp jtt =
	match jtt with
		| Jvm_class clazz -> []
		| Jvm_interface interface -> []
		| Jvm_enum enum -> []

(** take in Jvm_type.construct and return Jvm_bytecode.t list *)
let as_classfiles construct vers =
	List.map
		( fun jtt ->
				(match (as_jvm_version vers) with
						| JDK_1_1
						| JDK_1_2
						| JDK_1_3
						| JDK_1_4
						| JDK_1_5
						| JDK_1_7 -> (raise NotYetImplemented)
						| JDK_1_6 ->
							let clazzfile =
								{ (simple_classfile
											(as_fq_name ( Jvm_type.get_path jtt ) )
											(as_jvm_version vers))
									with access_flags = as_access_flags jtt ;
								} in
							
							clazzfile.super <- as_super clazzfile.constant_pool jtt ;
							
							clazzfile.interfaces <- as_interfaces clazzfile.constant_pool jtt ;
							
							clazzfile.fields <- as_fields clazzfile.constant_pool jtt ;
							
							clazzfile.methods <- as_methods clazzfile.constant_pool jtt	;
							
							(* TODO:complete these class       *)
							(* attributes hold typically a lot *)
							(* of meta information for         *)
							(* debugging purposes. but also    *)
							(* very important, in case of      *)
							(* inner classes, if this class    *)
							(* "holds" inner classes, they are *)
							(* referenced here via attribute.  *)
							(* vice versa, if this class "is"  *)
							(* an inner class ,the outer class *)
							(* (and method, if declared inside *)
							(* method), is referenced here     *)
							(* ,too.                           *)
							clazzfile.attributes <- as_attributes clazzfile.constant_pool jtt ;
							
							clazzfile )
			
		) construct

